home *** CD-ROM | disk | FTP | other *** search
/ Wonky Flux Batch 2019 02 / Wonky_Flux_Batch_2019-02.zip / Wonky Flux Batch 2019-02 / 071 - EXFER 4.1 4.2.dsk / EXFER.AUX.S < prev    next >
Text File  |  2019-02-17  |  17KB  |  469 lines
  1.                          ; *****************************
  2.                          ;
  3.                          ;            EXfer:
  4.                          ; The Extended Transfer Module
  5.                          ;
  6.                          ;  This program is for use on
  7.                          ;  the ProDOS version of GBBS
  8.                          ;  "Pro" 1.2 or "Pro" 1.3.
  9.                          ;
  10.                          ; Written by: Mike Golaszewski
  11.                          ; (C)1986, All Rights Reserved
  12.                          ;
  13.                          ; ****************************
  14.  
  15.                          ; THIS IS NOT FREEWARE
  16.  
  17.                          ; auxilliary function segment, version 4.1
  18.  
  19.                          ; created 08/22/86 - modified 11/09/87
  20.  
  21.                          ; A very warm "thank you" goes to the following people:  Jerry Cline, for all
  22.                          ; of his suggestions and for providing me with a development system while out
  23.                          ; in Phoenix; Steve Playford, for giving EXfer a new home and taking some
  24.                          ; tremendous pressure off of my back; Keith Christian for his contributions,
  25.                          ; input, and all the laughs.  Of course, thanks to Greg Schaefer too.
  26.  
  27.           on nocar goto terminate
  28.  
  29.           push return
  30.  
  31.           if i$="C" goto copy
  32.           if i$="H" goto help
  33.           if i$="K" goto kill
  34.           if i$="M" goto message
  35.           if i$="V" goto view
  36.           if i$="W" goto wallet
  37.           if i$="#" goto retype
  38.  
  39.                          ; return to the main EXfer segment
  40.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  41.  
  42. return
  43.           link "a:exfer.seg","prompt"
  44.  
  45.                          ; show credits available and library info
  46.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  47.  
  48. wallet
  49.           print 'Your wallet has 'cr' credits...
  50.  
  51. Uploads   to this library pay 'um' credits
  52. per       kilobyte       ; downloads cost 'dm' credits
  53. per       kilobyte.
  54.  
  55. Current   protocol: '    ;:if pt print "Ymodem batch"
  56.           if xm=0 print "Xmodem Standard":else if xm=1 print "Xmodem ProDOS"
  57.           if xm=2 print "Xmodem DOS":else if xm=3 print "ASCII"
  58.           return
  59.  
  60.                          ; display help on a command
  61.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~
  62.  
  63. help
  64.           input @2 "Help on which command: " i$:if i$="" return
  65.           x$="CDFHIKLMNRSTVX?B":x=instr(i$,x$):if x=0 return
  66.           ready "a1:hlp.exfer":print \s$\:input #msg(x),a,x$
  67.           input #6,x$:setint(1):print x$\:copy #6:setint("")
  68.           ready d2$:return
  69.  
  70.                          ; message to librarian
  71.                          ; ~~~~~~~~~~~~~~~~~~~~
  72.  
  73. message
  74.           print screen$"Enter feedback: ["edit(3)"] cols, [4K] Max"
  75.           print "[DONE] when finished, [.H] for help":edit(0)
  76.           edit(1):if not(edit(2)) then return:else ready "a:mail"
  77.           d=b1:if not(d) then d=1
  78.           if info(6)<29 print \"XT: Bit-map full":ready d2$:return
  79.           print #msg(d),un:print #6,"EXfer: Feedback from a user"\
  80.           print #6,"From ->"a1$" "a2$" [#"un"]"
  81.           print #6,"Date ->"date$" "time$\:copy #8,#6
  82.           print #msg(d),chr$(4);chr$(0);
  83.           msg(d)=1:update:ready d2$:return
  84.  
  85.                          ; view a file
  86.                          ; ~~~~~~~~~~~
  87.  
  88. view
  89.           if not(b3) goto lsec
  90.           input @2 "View: " i$:if i$="" return
  91.           if (val(i$)) or (left$(i$,1)="#") gosub nread:goto view.x
  92.           i$=left$(i$+chr$(32,14),15):gosub read
  93.           if not(l) goto nfile
  94.  
  95. view.x
  96.           if not(l) goto nfile
  97.           if not(byte(9)) print '
  98. XT:       This file must first be validated
  99.              by the sysop before it can be
  100.              accessed...':return
  101.           gosub name:f$=bf$+f$:gosub dtype
  102.           if ty$<>"TXT" print \"XT: Not a TXT type file...":return
  103.           gosub chkfil:if a close:goto nfile
  104.           print \s$\:setint(1):copy #1:close
  105.           setint(""):if not(lb) then cr=cr-((byte(10)+byte(11)*256)/2)*dm
  106.           return
  107.  
  108.                          ; kill a file
  109.                          ; ~~~~~~~~~~~
  110.  
  111.                          ; make sure the file belongs to the user
  112.  
  113. kill
  114.           input @2 "Kill: " i$:if i$="" return
  115.           if (val(i$)) or (left$(i$,1)="#") gosub nread:l=l-1:goto kill.x
  116.           i$=left$(i$+chr$(32,14),15):gosub read
  117.           if not(l) goto nfile
  118.  
  119. kill.x
  120.           if l<0 goto nfile
  121.           if lb goto kill.1:else a=byte(12)+byte(13)*256
  122.           if a<>un print \"XT: That is not your file":return
  123.  
  124.                          ; kill the file
  125.  
  126. kill.1
  127.           gosub name:i$="Y":if info(5) input @0 \"XT: Remove file from disk ? " i$
  128.           f$=bf$+f$:x=byte(14):fill ram2+9,32,0:if i$="Y" kill f$
  129.           open #1,d1$:position #1,32,l+1:print #1,chr$(13):write #1,ram2+9,30:close
  130.           if not(v) then nibble(3)=nibble(3)-(a=un):else ul=ul-(a=un)
  131.           if not(x) goto getslt
  132.  
  133.                          ; scan for the message containing file's information
  134.  
  135. kill.2
  136.           msg(x)=0:kill #msg(x):update:goto getslt
  137.  
  138.                          ; copy a file
  139.                          ; ~~~~~~~~~~~
  140.  
  141. copy
  142.           if not(b4) goto lsec:else if nb=255 goto dfull
  143.           input @2 "Copy: " i$:if i$="" return
  144.           na$=left$(i$+chr$(32,14),15):i$=na$:gosub read
  145.           gosub name:f$=bf$+f$:gosub chkfil:close
  146.           if a and not(l) goto copy.2
  147.           if lb goto copy.1:else print '
  148. XT:       'chr$(7)"Duplicate name on ProDOS volume":return
  149.  
  150.                          ; see what sysop wishes to do with duplicate
  151.  
  152. copy.1
  153.           if l then nb=l
  154.           input @0 \"XT: File exists...overwrite ? " i$
  155.           if i$<>"Y" return:else kill f$
  156.  
  157.                          ; get the text
  158.  
  159. copy.2
  160.           print screen$'
  161. For       files exceeding 4096 bytes, use the
  162. R)eceive  command...
  163.  
  164. Enter     text: 'edit(3)' columns, [4K] max
  165. [DONE]    when finished, [.H] for help'
  166.           edit(0):edit(1):if not(edit(2)) return
  167.           input @0 \"XT: Is this a Ymodem list macro ? " i$
  168.  
  169.                          ; get some info on the file
  170.  
  171.           create f$:open #1,f$:copy #8,#1:close
  172.           nibble(3)=nibble(3)+1:gosub size:gosub sfile
  173.           byte(14)=0:byte(15)=0:ty$="TXT":if i$="Y" then ty$="LST"
  174.           push getslt:if nb<>byte(4) goto write:else goto update
  175.  
  176.                          ; user has dropped carrier
  177.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~
  178.  
  179. terminate
  180.           byte=ram2:byte(0)=xm+(8*pt):byte(1)=1:byte(2)=cr mod 256:byte(3)=cr/256
  181.           open #1,"a1:xt.users":position #1,4,un:write #1,ram2,4:close
  182.           poke ram2,v:when$=ram+20:if not(v) then byte=ram+29:goto byecon.1
  183.           byte=ram+37:nibble(3)=dl/256:byte(3)=dl mod 256
  184.           nibble(4)=ul/256:byte(4)=ul mod 256
  185.  
  186. byecon.1
  187.           print '
  188.           :::::::::::::::::::::::::::::::::::::
  189. :         EXfer v4.1 - Hackers  Hotline  BBS  :
  190.           :::::::::::::::::::::::::::::::::::::'
  191.           flag=ram+22:clear:recall "a:variables":kill "a:variables":x=peek(ram2)
  192.           if x=13 then ul=byte(4)+nibble(4)*256:dl=byte(3)+nibble(3)*256
  193.           link "a:main.seg","term1"
  194.  
  195.                          ; ::::::::::::::::::::
  196.                          ; disk I/O subroutines
  197.                          ; ::::::::::::::::::::
  198.  
  199.                          ; get an empty slot
  200.                          ; ~~~~~~~~~~~~~~~~~
  201.  
  202. getslt
  203.           nb=0:open #1,d1$:for l=1 to byte(4)
  204.           position #1,32,l+1:input #1,i$
  205.           if (i$="") and (nb=0) then nb=l:l=byte(4)
  206.           next:close:if not(nb) then nb=byte(4)
  207.           return
  208.  
  209.                          ; update "number of entries" counter
  210.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  211.  
  212. update
  213.           byte(4)=byte(4)+1:open #1,d1$:print #1,bn$
  214.           print #1,bf$:write #1,ram2,9:close
  215.  
  216.                          ; write a directory entry
  217.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  218.  
  219. write
  220.           open #1,d1$:position #1,32,nb+1:print #1,na$
  221.           print #1,ty$:write #1,ram2+9,10:close
  222.           z=nb:return
  223.  
  224.                          ; read a directory entry
  225.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  226.  
  227. read
  228.           open #1,d1$:for l=1 to byte(4)
  229.           position #1,32,l+1:input #1,f$
  230.           if instr(i$,f$)=1 then p=l:l=byte(4):next:l=p:goto read.1
  231.           next:close #1:l=0:return
  232.  
  233. read.1
  234.           input #1,ty$:read #1,ram2+9,10:close #1
  235.           return
  236.  
  237.                          ; read a file by slot #
  238.                          ; ~~~~~~~~~~~~~~~~~~~~~
  239.  
  240. nread
  241.           if left$(i$,1)="#" then i$=mid$(i$,2)
  242.           l=val(i$):if (l<2) or (l>253) then l=0:return
  243.           open #1,d1$:position #1,32,l
  244.           input #1,f$:if f$="" close #1:l=0:return
  245.           input #1,ty$:read #1,ram2+9,10:close #1
  246.           i$=f$:if pt=2 return:else print \"XT: [#"l"]: "i$:return
  247.  
  248.                          ; find the type of a file
  249.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  250.  
  251. dtype
  252.           use "a1:xtyp",f$:x=peek(ram2+32)
  253.           x$="???0TXT4PDA5BIN6ADB25AWP26ASP27SRC176OBJ177LIB178S16179RTL180EXE181"
  254.           x$=x$+"STR182RIF183NDA184CDA185SET186PNT192PIC193ANI194$DD221PAS239CMD240"
  255.           x$=x$+"COM245P16249BAS252VAR253REL254SYS255"
  256.           ty$="":y=instr(str$(x),x$):if y then ty$=mid$(x$,y-3,3):return
  257.           ty$="$"+chr$(48+x/16+((x/16)>9)*7)+chr$(48+x mod 16+((x mod 16)>9)*7)
  258.           return
  259.  
  260.                          ; return the size of F$ in A
  261.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~
  262.  
  263. size
  264.           open #1,f$:a=size(1)/2+1:close:return
  265.  
  266.                          ; see if file exists
  267.                          ; ~~~~~~~~~~~~~~~~~~
  268.  
  269. chkfil
  270.           open #1,f$:a=mark(1):return
  271.  
  272.                          ; :::::::::::::::::::
  273.                          ; special subroutines
  274.                          ; :::::::::::::::::::
  275.  
  276.                          ; convert to a valid ProDOS name
  277.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  278.  
  279.                          ; shorten I$ to directory length
  280.  
  281. name
  282.           if len(i$)>15 then i$=left$(i$,15)
  283.           i$=i$+chr$(1)
  284.  
  285.                          ; make sure the first char is a letter
  286.  
  287. name.0
  288.           a=asc(left$(i$,1)):if a=1 pop:return
  289.           if (a>64) and (a<91) then i$=left$(i$,len(i$)-1):goto name.1
  290.           if (a>96) and (a<123) then i$=left$(i$,len(i$)-1):goto name.1
  291.           i$=mid$(i$,2):goto name.0
  292.  
  293.                          ; remove symbols from the name
  294.  
  295. name.1
  296.           f$="":for x=1 to len(i$):a=asc(mid$(i$,x,1))
  297.           if (a>64) and (a<91) goto name.2
  298.           if (a>96) and (a<123) goto name.2
  299.           if (a>47) and (a<58) goto name.2
  300.           if a=46 goto name.2:else goto name.3
  301.  
  302.                          ; add a valid character
  303.  
  304. name.2
  305.           f$=f$+chr$(a)
  306.  
  307.                          ; if we dont have a name, return to the prompt
  308.  
  309. name.3
  310.           next:if f$="" pop:return
  311.           if len(f$)>15 then f$=left$(f$,15)
  312.           return
  313.  
  314.                          ; set file information
  315.                          ; ~~~~~~~~~~~~~~~~~~~~
  316.  
  317. sfile
  318.           byte(9)=byte(3):byte(10)=a mod 256:byte(11)=a/256
  319.           byte(12)=un mod 256:byte(13)=un/256:byte(18)=0
  320.           when$="x":if lb then byte(9)=255
  321.           return
  322.  
  323.                          ; ::::::::::::::
  324.                          ; error messages
  325.                          ; ::::::::::::::
  326.  
  327. lsec
  328.           print \"XT:"chr$(7)" Security too low...":return
  329.  
  330. dfull
  331.           print \"XT:"chr$(7)" Directory full...":return
  332.  
  333. nfile
  334.           print \"XT:"chr$(7)" No such file...":return
  335.  
  336. retype
  337.           i=0:input @2 "Re-type which file? [<CR>=Abort]:" i$:if i$="" return
  338.           if left$(i$,1)="?" gosub directory:print \:goto retype
  339.           if (val(i$)) or (left$(i$,1)="#") gosub nread:goto retype2
  340.           i$=left$(i$+chr$(32,14),15):gosub read
  341.           if l=0 goto nfile
  342. retype2
  343.           print \"    Current type: "ty$
  344.           input @2 "New type [0-255]: " re$:if re$="" return
  345.           if re$="?" copy "a1:f.types":goto retype2
  346.           x=val(re$)
  347.           if (x>255) or (x<0) return
  348.           if (x>249) and (x<252) return
  349.           if (x>245) and (x<249) return
  350.           if (x>240) and (x<245) return
  351.           if (x>221) and (x<239) return
  352.           if (x>200) and (x<221) return
  353.           if (x>194) and (x<200) return
  354.           if (x>186) and (x<192) return
  355.           if (x>27) and (x<176) return
  356.           if (x>6) and (x<25) return
  357.           if (x>0) and (x<4) return
  358.           if x<>6 goto retype3
  359.           print '
  360. (1>       BIN (regular binary)
  361. (2>       BNY (binary II)
  362. (3>       BQY (binary II squeezed)
  363. (4>       SQZ (squeezed only)';:input @2\"Which? [1-4] [<CR>=Abort]:" re$
  364.           i=val(re$):if (i<1) and (i>4) print \"Aborted...":return
  365. retype3
  366.           a$=f$:f$=bf$+f$
  367.           gosub type
  368.           gosub dtype
  369.           f$=a$
  370.           if i=1 then ty$="BIN"
  371.           if i=2 then ty$="BNY"
  372.           if i=3 then ty$="BQY"
  373.           if i=4 then ty$="SQZ"
  374.           open #1,d1$:position #1,32,l:print #1,f$
  375.           print #1,ty$:write #1,ram2+9,10:close
  376.           input @2\"Another? [Y/<N>]:" i$:if left$(i$,1)<>"Y" return
  377.           print \:goto retype
  378.  
  379.  
  380.                          ; :::::::::::::::::::
  381.                          ; library subroutines
  382.                          ; :::::::::::::::::::
  383.  
  384.                          ; catalog a library
  385.                          ; ~~~~~~~~~~~~~~~~~
  386.  
  387.                          ; print directory headers
  388.  
  389. directory
  390.           if not(b3) goto lsec
  391.           print screen$:gosub dir.h:use "a1:xtyp",bf$
  392.  
  393.                          ; grab an entry
  394.  
  395.           open #1,d1$:for l=1 to byte(4):f$=""
  396.           position #1,32,l+1:input #1,f$:input #1,ty$
  397.           position #1,32,l+1,20:read #1,ram2+9,10:if f$="" goto dir.1
  398.           setint(1)
  399.  
  400.                          ; if its valid, print it
  401.  
  402.           gosub dir.e:print:if byte(9) goto dir.1
  403.           if (not(byte(9))) and (not(lb)) goto dir.1
  404.  
  405.                          ; update if not validated
  406.  
  407.           print chr$(7,3);"** Validate above file [Y/N/K] ? ";:get i$
  408.           print chr$(8,35);chr$(32,35);chr$(8,35)
  409.           if i$="Y" position #1,32,l+1,20:print #1,chr$(255);
  410.           if i$<>"K" goto dir.1:else position #1,32,l+1:fill ram2+9,31,0
  411.           print #1,chr$(13):write #1,ram2+9,30:i$=f$:gosub name
  412.           kill f$:if l<nb then nb=l
  413.  
  414. dir.1
  415.           if key(1) then l=byte(4)
  416.           next:close:setint("")
  417.           x=peek(865)+peek(866)*256:y=peek(867)+peek(868)*256
  418.           z=x-y:print \chr$(14)"Kbytes Free: "left$(str$(z)+chr$(32,4),5);
  419.           print "  "     ;right$("   Kbytes Used: "+str$(y),19);
  420.           if edit(3)>39 print chr$(32,9)"Total Kbytes: "x:else print
  421.           return
  422.  
  423.                          ; :::::::::::::::::::::
  424.                          ; directory subroutines
  425.                          ; :::::::::::::::::::::
  426.  
  427.                          ; show a directory header
  428.  
  429. dir.h
  430.           print right$("00"+str$(bb),3)": "bn$;
  431.           if edit(3)>39 print chr$(32,22)"Librarian:";
  432.           print " "right$("00"+str$(b1),3)\\" #  Filename       Type ";
  433.           if edit(3)<79 print "Size Dated Cost"\:return
  434.           print "I Size Uploaded Uploader Dnloaded Credits Misc"\
  435.           return
  436.  
  437.                          ; show a directory entry
  438.  
  439. dir.e
  440.           print right$("00"+str$(l+1),3)" "f$" "ty$" ";:if edit(3)<79 goto dir.x
  441.           if byte(14) print "Y ";:else print "N ";
  442.  
  443. dir.x
  444.           x=byte(10)+byte(11)*256:print right$("   "+str$(x),4)" ";
  445.           b$=when$:a$=right$(b$,3)+left$(b$,5):y=byte(18):x=byte(12)+byte(13)*256
  446.           if edit(3)<79 goto dir.40
  447.           if not(byte(9)) poke 50,255:print chr$(15)"VALIDATE"chr$(14);:poke 50,0
  448.           if (byte(9)) and (lc$>a$) print b$;:goto dir.c
  449.           if not(byte(9)) goto dir.c
  450.           poke 50,255:print chr$(15)"NEW FILE"chr$(14);:poke 50,0
  451.  
  452. dir.c
  453.           print " User "right$("00"+str$(x),3)" "right$("  "+str$(y),3)" times ";
  454.           x=((byte(10)+byte(11)*256)/2)*dm:print right$("      "+str$(x),7)" ";
  455.           if lc$<=a$ print "NEW";
  456.           return
  457.  
  458. dir.40
  459.           if not(byte(9)) print " VAL ";
  460.           if (lc$>a$) and (byte(9)) print left$(b$,5);:else if byte(9) print " NEW ";
  461.           x=((byte(10)+byte(11)*256)/2)*dm:if cr>=x print "$";:else print " ";
  462.           print right$("   "+str$(x),4);:return
  463.  
  464.                          ; set the type of a file
  465.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  466.  
  467. type
  468.           use "a1:xtyp",f$,x:return
  469.